home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 April / EnigmA AMIGA RUN 17 (1997)(G.R. Edizioni)(IT)[!][issue 1997-04][EAR-CD].iso / EARCD / text / dtp / PicCatalog211.lha / PicCatalog211.rexx < prev   
OS/2 REXX Batch file  |  1996-11-03  |  29KB  |  952 lines
  1. /*--------------------------------------*/
  2. /* $VER: PicCatalog V2.11 (03 Nov 1996) */
  3. /* ©1996 Michael Merkel                 */
  4. /*--------------------------------------*/
  5.  
  6. /*
  7.    how to use this:
  8.    ----------------
  9.  
  10.    1. open a new document
  11.    2. start this script
  12.    3. select a picture directory
  13.    4. select fixed or not fixed
  14.       (if you select fixed you _must_ specify the maximum size of a picture in the
  15.        #horizontal/#vertical textfields!
  16.        otherwise you _must_ specify the number of pictures in these fields!)
  17.    5. press "make"
  18.  
  19.  
  20.    comments to this program to:
  21.    ----------------------------
  22.       mmerkel@rummelplatz.uni-mannheim.de
  23.  
  24.    Regards...
  25.    Michael Merkel
  26. */
  27.  
  28. OPTIONS RESULTS
  29.  
  30. /* Make sure rexx support is opened */
  31. IF ~SHOW('L','rexxsupport.library') THEN
  32.    CALL ADDLIB('rexxsupport.library',0,-30)
  33. IF ~SHOW('L','softlogik:libs/slarexxsupport.library') THEN
  34.    CALL ADDLIB('softlogik:libs/slarexxsupport.library',0,-30)
  35. ADDRESS 'PAGESTREAM'
  36.  
  37. /* defaults */
  38.  
  39. pcversion = 'V2.11'
  40. formats = 'bmp gif iffilbm jpeg pcx pict tiff artexpressioneps dr2d eps iffilus illustratoreps pagestream3doc'
  41.  
  42. 'GETPAGEMASTERPAGE MASTERPAGE mname'
  43. if (RC = 10) then CALL DOERRORREQUESTER
  44.  
  45. defmeasure = GetDefaultMeasurementSystem()
  46.  
  47. 'GETDIMENSIONS dim MASTERPAGE "'mname'"'
  48. if (dim.orientation = 'PORTRAIT') then do
  49.     rpagesizex = dim.width
  50.     rpagesizey = dim.height
  51.     end
  52. else do
  53.     rpagesizex = dim.height
  54.     rpagesizey = dim.width
  55. end
  56.  
  57. measure = 'pt'
  58. tf.0 = 'FALSE'
  59. tf.1 = 'TRUE'
  60. CALL ReadPrefs
  61.  
  62. /* get user choices */
  63.  
  64.  CALL DOREQUESTER
  65.  if (ergebnis = cancelhandler)
  66.  then do
  67.     ''defmeasure''
  68.     EXIT
  69.  end
  70.  CALL WritePrefs
  71.  
  72. /* transform to same measurement system */
  73.  
  74. pagesizex = rpagesizex
  75. pagesizey = rpagesizey
  76. leftgap = p2d(WORD(rgapsnsize,1),measure)
  77. rightgap = p2d(WORD(rgapsnsize,2),measure)
  78. topgap = p2d(WORD(rgapsnsize,3),measure)
  79. bottomgap = p2d(WORD(rgapsnsize,4),measure)
  80. gap = p2d(WORD(rgapsnsize,5),measure)
  81. txtsize = p2d(WORD(rgapsnsize,6),measure)
  82. startx = leftgap
  83. starty = topgap
  84. if (fps = 0)
  85. then do
  86.     psx = (pagesizex-leftgap-rightgap-(numx-1)*gap) / numx
  87.     psy = (pagesizey-topgap-bottomgap-(numy-1)*gap-numy*txtsize) / numy
  88.     psf = psx / psy
  89.     anzp = numx * numy
  90. end
  91. else do
  92.     psx = p2d(numx,measure)
  93.     psy = p2d(numy,measure)
  94.     psf = psx / psy
  95. end
  96.  
  97. if (Open('dump','T:PicCatalog.dumpfile','W') = 1) then do
  98.     wl=WriteLN('dump','DUMPFILE for PicCatalog '||pcversion||' - ©1996 Michael Merkel')
  99.     cl=Close('dump')
  100. end
  101.  
  102. num = 0
  103. nppp = 0
  104. pagenumber = 1
  105. maxheight = 0
  106.  
  107. /* draw border for first page */
  108. CALL DrawPageBorder
  109.  
  110. BusyReq = OpenBusyMessage('getting pictures ...')
  111. 'REFRESH OFF'
  112.  
  113. dummy = RekDir(pdir)
  114.  
  115. if (nppp=0) then 'DELETEPAGE'
  116. if ((nppp > 0) & (print = 1))
  117. then do    /* ready but not yet printed */
  118.     Call SetBusyMessage(BusyReq,'refreshing display...')
  119.     'REFRESH ON'
  120.     'REFRESHWINDOW'
  121.  
  122.     CALL PrintPage
  123. end
  124.  
  125. CALL CLEANUP
  126.  
  127. AddPicture:
  128.     ARG name
  129.  
  130.     CALL DumpText('('||num||') '||name||' -> ',0)
  131.  
  132.     do while (PlaceGraphic(name) > 0)
  133.         if (lastpic = 1)
  134.         then do    /* last picture placed on page */
  135.             Call SetBusyMessage(BusyReq,'refreshing display...')
  136.             'REFRESH ON'
  137.             'REFRESHWINDOW'
  138.  
  139.             if (print = 1) then CALL PrintPage
  140.             else 'DISPLAY PAGE NEXT'
  141.             pagenumber = pagenumber + 1
  142.             nppp = 0
  143.             CALL DrawPageBorder
  144.  
  145.             'REFRESH OFF'
  146.         end
  147.     end
  148.     num = num + 1
  149. RETURN
  150.  
  151. PlaceGraphic:
  152.     ARG name
  153.  
  154.     CALL getbusy(name)
  155.  
  156. /* this prevents ARexx to show error messages (RC=10) if pictype is wrong */
  157. OPTIONS FAILAT 11
  158.  
  159.     pictype = 0
  160.     fileget = 0
  161.     document3 = 0
  162.  
  163.     /* ----------------------------------------------------------------- pgs3 documents! */
  164.  
  165.     if (WORD(lformats,WORDS(formats)) = 1)
  166.     then do
  167.         'CURRENTWINDOWPATH'
  168.          oldwinname = RESULT
  169.  
  170.         'OPENDOCUMENT FILE "'name'" FILTER "IFFDOC"'
  171.         if (RC = 0)
  172.         then do
  173.             'REFRESH ON'
  174.             'OPENWINDOW "PICdumm" PAGE 1 SCALE "10%"'
  175.  
  176.             if (BusyReq>0) then 'CLOSEBUSYREQUESTER 'BusyReq
  177.  
  178.             'REFRESH OFF'
  179.  
  180.             'GETPAGEMASTERPAGE MASTERPAGE mname2 DEPTH mwhere2'
  181.              mdisplayed = RESULT
  182.  
  183.             'GETDIMENSIONS dim2 MASTERPAGE "'mname2'"'
  184.             if (dim2.orientation = 'PORTRAIT')
  185.             then do
  186.                 px2 = dim2.width
  187.                 py2 = dim2.height
  188.             end
  189.             else do
  190.                 px2 = dim2.height
  191.                 py2 = dim2.width
  192.             end
  193.  
  194.             if mdisplayed = 'ON'
  195.             then do
  196.                 'DISPLAY MPG RIGHT SCALE "10%"'
  197.                 'SELECTOBJECT ALL'
  198.                 'UNLOCK'
  199.                 'TRANSFORM 1'
  200.                 'MOVETOPAGE PAGE 1'
  201.                 'DISPLAY PAGE 1 SCALE "10%"'
  202.                 if mwhere2 = 'INBACK' then 'SENDTOBACK'
  203.                 else                       'SENDTOFRONT'
  204.             end
  205.             'DRAWBOX 0 0 'px2 py2
  206.             'SELECTOBJECT ALL'
  207.             'UNLOCK'
  208.             'CREATEDRAWING BEST'
  209.             'COPYOBJECT'
  210.  
  211.             'CLOSEDOCUMENT FORCE'
  212.  
  213.             'REVEALWINDOW WINDOW "'oldwinname'"'
  214.             'PASTEOBJECT'
  215.              fileget = 1
  216.              document3 = 1
  217.             BusyReq = OpenBusyMessage('placing document...')
  218.         end
  219.     end
  220.  
  221. /* ----------------------------------------------------------------- bitmaps! */
  222.  
  223.     if fileget = 0
  224.     then do
  225.         do filegc = 1 to WORDS(formats)
  226.             if (WORD(lformats,filegc) = 1)
  227.             then do
  228.                 'PLACEGRAPHIC FILE "'name'" FILTER "'WORD(formats,filegc)'" PROGRESS'
  229.                 if (RC = 0)
  230.                 then do
  231.                     fileget = 1
  232.                     LEAVE
  233.                 end
  234.             end
  235.         end
  236.     end
  237.  
  238. /* ------------------------------------------------------------- endfiletypes */
  239.  
  240. OPTIONS FAILAT 10
  241.  
  242.     if (fileget = 1)
  243.     then do
  244.         'GETOBJECT TYPE objtype'
  245.         SELECT
  246.             WHEN (objtype = 2 ) THEN pictype = 2
  247.             WHEN (objtype = 12) THEN pictype = 1
  248.             WHEN (objtype = 13) THEN pictype = 3
  249.         END
  250.         SELECT
  251.             WHEN (pictype = 1) THEN 'GETPICTURE POSITION 'posi
  252.             WHEN (pictype = 2) THEN 'GETDRAWING POSITION 'posi
  253.             WHEN (pictype = 3) THEN 'GETEPS POSITION 'posi
  254.         END
  255.         picid = RESULT
  256.  
  257.         d1 = startx
  258.         d2 = starty
  259.  
  260.         pwidth = posi.right - posi.left
  261.         pheight = posi.bottom - posi.top
  262.  
  263.         if (fps=0)
  264.         then do
  265.             gsf = pwidth / pheight
  266.             if (gsf > psf) then factor = psx / pwidth
  267.             else                factor = psy / pheight
  268.  
  269.             newpwidth = factor * pwidth - 2
  270.             newpheight = factor * pheight - 2
  271.  
  272.             centerdeltax = (psx - newpwidth) / 2
  273.             centerdeltay = (psy - newpheight) / 2
  274.  
  275.             d3 = d1 + psx
  276.             d4 = d2 + psy
  277.  
  278.             if ((d3 - 1) > (pagesizex - rightgap)) /* well, it's too far right! */
  279.             then do
  280.                 startx = leftgap
  281.                 starty = d4 + gap + txtsize
  282.                 d1 = startx
  283.                 d2 = starty
  284.                 d3 = d1 + psx
  285.                 d4 = d2 + psy
  286.             end
  287.  
  288.             if ((d4 + txtsize - 1) > (pagesizey - bottomgap)) /* now it's too far down! */
  289.             then do
  290.                 startx = leftgap
  291.                 starty = topgap
  292.                 lastpic = 1       /* last picture already placed! print or flip page and go on... */
  293.                 'DELETEOBJECT OBJECTID 'picid
  294.                 RETURN 1
  295.             end
  296.  
  297.             startx = d3 + gap
  298.  
  299.             newl = d1 + centerdeltax
  300.             newt = d2 + centerdeltay
  301.             newr = newl + newpwidth
  302.             newb = newt + newpheight
  303.  
  304.             SELECT
  305.                 WHEN (pictype = 1)
  306.                     THEN 'EDITPICTURE POSITION 'newl newt newr newb' stored "EXTERNAL" OBJECTID 'picid
  307.                 WHEN (pictype = 2)
  308.                     THEN if (document3 = 1)
  309.                         THEN 'EDITDRAWING POSITION 'newl newt newr newb' OBJECTID 'picid
  310.                         else 'EDITDRAWING POSITION 'newl newt newr newb' stored "EXTERNAL" OBJECTID 'picid
  311.                 OTHERWISE
  312.                     'EDITEPS POSITION 'newl newt newr newb' stored "EXTERNAL" OBJECTID 'picid
  313.             END
  314.         end
  315.         else do
  316.             gsf = pwidth / pheight
  317.             if (gsf > psf) then factor = psx / pwidth
  318.             else                factor = psy / pheight
  319.  
  320.             newpwidth = factor * pwidth
  321.             newpheight = factor * pheight
  322.  
  323.             d3 = d1 + newpwidth + 6
  324.             d4 = d2 + newpheight + 6
  325.  
  326.             if ((d3 - 1) > (pagesizex - rightgap)) /* well, it's too far right! */
  327.             then do
  328.                 startx = leftgap
  329.                 starty = d2 + maxheight + 6 + gap + txtsize
  330.                 d1 = startx
  331.                 d2 = starty
  332.                 d3 = d1 + newpwidth + 6
  333.                 d4 = d2 + newpheight + 6
  334.                 if ((d3 - 1) > (pagesizex - rightgap)) then call ErrorExit
  335.                 maxheight = 0
  336.             end
  337.  
  338.             if ((d4 + txtsize - 1) > (pagesizey - bottomgap)) /* now it's too far down! */
  339.             then do
  340.                 startx = leftgap
  341.                 starty = topgap
  342.                 if ((starty + newpheight + 6  + txtsize - 1) > (pagesizey - bottomgap)) then call ErrorExit
  343.                 maxheight = 0
  344.                 lastpic = 1       /* last picture already placed! print or flip page and go on... */
  345.                 'DELETEOBJECT OBJECTID 'picid
  346.                 RETURN 1
  347.             end
  348.  
  349.             if (newpheight > maxheight) then maxheight = newpheight
  350.             startx = d3 + gap
  351.  
  352.             newl = d1 + 3
  353.             newt = d2 + 3
  354.             newr = d3 - 3
  355.             newb = d4 - 3
  356.  
  357.             SELECT
  358.                 WHEN (pictype = 1)
  359.                     THEN 'EDITPICTURE POSITION 'newl newt newr newb' stored "EXTERNAL" OBJECTID 'picid
  360.                 WHEN (pictype = 2)
  361.                     THEN if (document3 = 1)
  362.                         THEN 'EDITDRAWING POSITION 'newl newt newr newb' OBJECTID 'picid
  363.                         else 'EDITDRAWING POSITION 'newl newt newr newb' stored "EXTERNAL" OBJECTID 'picid
  364.                 OTHERWISE
  365.                     'EDITEPS POSITION 'newl newt newr newb' stored "EXTERNAL" OBJECTID 'picid
  366.             END
  367.         end
  368.         if (txtsize > 0) then do
  369.             'DRAWTEXTOBJ 'd1 d4' INFRONT'
  370.              txtid = RESULT
  371.             'SELECTTEXT AT 'd1 d4' FRONTMOST'
  372.  
  373.             'BEGINCOMMANDCAPTURE'
  374.              'SETTRACKTABLE NONE'
  375.              'SETLEADING RELATIVE 100%'
  376.              'SETTYPESIZE 'txtsize
  377.              'SETPARAGRAPHSTYLE "PicName"'
  378.             'ENDCOMMANDCAPTURE'
  379.  
  380.             if (prname = 0) then 'INSERT "'name'"'
  381.             else do
  382.                 name2 = reverse(name)
  383.                 pos = pos('/',name2)
  384.                 if (pos = 0) then pos = pos(':',name2)
  385.                 name3 = right(name,pos-1)
  386.                 'INSERT "'name3'"'
  387.             end
  388.             'GETTEXTOBJ POSITION txtpos OBJECTID 'txtid
  389.             txtp2.left   = txtpos.left
  390.             txtp2.top    = txtpos.top
  391.             txtp2.bottom = txtpos.bottom
  392.             txtp2.right  = txtpos.right
  393.  
  394.             txtwidth = txtp2.right - txtp2.left
  395.             if (txtwidth > (d3-d1)) then 'EDITTEXTOBJ POSITION 'txtp2.left txtp2.top d3 txtp2.bottom' OBJECTID 'txtid
  396.         end
  397.  
  398.         'DRAWBOX 'd1 d2 d3 d4
  399.         'SETSTROKEWEIGHT 1pt'
  400.  
  401.         nppp = nppp + 1
  402.         CALL DumpText('....created',1)
  403.     end
  404.     else CALL DumpText('....NOT created',1)
  405. RETURN 0
  406.  
  407. DOREQUESTER:
  408.     filehandler = 0
  409.     ergebnis = filehandler
  410.     do until ((ergebnis = okhandler) | (ergebnis = cancelhandler))
  411.         'ALLOCAREXXREQUESTER "PicCatalog '||pcversion||' - ©1996 Michael Merkel" 350 280'
  412.          reqhandle = RESULT
  413.         'ADDAREXXGADGET 'reqhandle' EXIT 10  260 70 LABEL "_Make"'
  414.          okhandler = RESULT
  415.         'ADDAREXXGADGET 'reqhandle' EXIT 270 260 70 LABEL "_Cancel"'
  416.          cancelhandler = RESULT
  417.         'ADDAREXXGADGET 'reqhandle' EXIT 115 260 120 LABEL "_Print Settings"'
  418.          pprefshandler = RESULT
  419.  
  420.         'ADDAREXXGADGET 'reqhandle' STRING 215  5  55 STRING "'numx'" LABEL "# of pictures horizontal:"'
  421.          numx_gadget = RESULT
  422.         'ADDAREXXGADGET 'reqhandle' STRING 215 20  55 STRING "'numy'" LABEL "# of pictures vertical:  "'
  423.          numy_gadget = RESULT
  424.  
  425.         'ADDAREXXGADGET 'reqhandle' CHECKBOX 280 15 10  CHECKED "'tf.fps'" LABEL "fixed"'
  426.          fps_gadget = RESULT
  427.  
  428.         'ADDAREXXGADGET 'reqhandle' TEXT   10  40 112 STRING "page offsets:"'
  429.  
  430.         'ADDAREXXGADGET 'reqhandle' STRING 63  60 70 STRING "'WORD(rgapsnsize,1)'"  LABEL "left:"'
  431.          rleftgap_gadget = RESULT
  432.         'ADDAREXXGADGET 'reqhandle' STRING 63  75 70 STRING "'WORD(rgapsnsize,2)'" LABEL "right:"'
  433.          rrightgap_gadget = RESULT
  434.         'ADDAREXXGADGET 'reqhandle' STRING 200 60 70 STRING "'WORD(rgapsnsize,3)'"    LABEL "top:"'
  435.          rtopgap_gadget = RESULT
  436.         'ADDAREXXGADGET 'reqhandle' STRING 200 75 70 STRING "'WORD(rgapsnsize,4)'" LABEL "bottom:"'
  437.          rbottomgap_gadget = RESULT
  438.  
  439.         'ADDAREXXGADGET 'reqhandle' STRING 183 100 50 STRING "'WORD(rgapsnsize,5)'" LABEL "gap between pictures:"'
  440.          rgap_gadget = RESULT
  441.  
  442.         'ADDAREXXGADGET 'reqhandle' STRING 183 120 50 STRING "'WORD(rgapsnsize,6)'" LABEL "textsize (0 = none): "'
  443.          rtxtsize_gadget = RESULT
  444.  
  445.         'ALLOCAREXXLIST'
  446.          rexxlist = RESULT
  447.         'ADDAREXXLIST 'rexxlist' "full path"'
  448.         'ADDAREXXLIST 'rexxlist' "name only"'
  449.         'ADDAREXXGADGET 'reqhandle' CYCLE 240 120 100'
  450.          prname_gadget = RESULT
  451.         'SETAREXXGADGET 'reqhandle' 'prname_gadget' LIST 'rexxlist' CURRENT 'prname
  452.  
  453.         'ADDAREXXGADGET 'reqhandle' STRING 10  150 300 STRING "'pdir'" LABEL "picture path:" LABELPOS "ABOVELEFT"'
  454.          pdir_gadget = RESULT
  455.         'ADDAREXXGADGET 'reqhandle' EXIT   315 150 10  LABEL "_?"'
  456.          filehandler = RESULT
  457.         'ADDAREXXGADGET 'reqhandle' CHECKBOX 10 170 10  CHECKED "'tf.lreku'" LABEL "do directories recursive"'
  458.          lreku_gadget = RESULT
  459.  
  460.         'ADDAREXXGADGET 'reqhandle' EXIT 115 195 120 LABEL "_Type Settings"'
  461.          ptypehandler = RESULT
  462.  
  463.         'ADDAREXXGADGET 'reqhandle' CHECKBOX 10  230 10  CHECKED "'tf.print'" LABEL "print every single page"'
  464.          print_gadget = RESULT
  465.         'ADDAREXXGADGET 'reqhandle' TEXT     30  240 240 STRING "(instead of collecting them)"'
  466.  
  467.         'DOAREXXREQUESTER 'reqhandle
  468.          ergebnis = RESULT
  469.  
  470.         'GETAREXXGADGET 'reqhandle' 'numx_gadget' STRING'
  471.          numx = RESULT
  472.         'GETAREXXGADGET 'reqhandle' 'numy_gadget' STRING'
  473.          numy = RESULT
  474.  
  475.         'GETAREXXGADGET 'reqhandle' 'rleftgap_gadget' STRING'
  476.          rgapsnsize = SPACE(RESULT,0)
  477.         'GETAREXXGADGET 'reqhandle' 'rrightgap_gadget' STRING'
  478.          rgapsnsize = rgapsnsize SPACE(RESULT,0)
  479.         'GETAREXXGADGET 'reqhandle' 'rtopgap_gadget' STRING'
  480.          rgapsnsize = rgapsnsize SPACE(RESULT,0)
  481.         'GETAREXXGADGET 'reqhandle' 'rbottomgap_gadget' STRING'
  482.          rgapsnsize = rgapsnsize SPACE(RESULT,0)
  483.  
  484.         'GETAREXXGADGET 'reqhandle' 'rgap_gadget' STRING'
  485.          rgapsnsize = rgapsnsize SPACE(RESULT,0)
  486.         'GETAREXXGADGET 'reqhandle' 'rtxtsize_gadget' STRING'
  487.          rgapsnsize = rgapsnsize SPACE(RESULT,0)
  488.         'GETAREXXGADGET 'reqhandle' 'prname_gadget' CURRENT'
  489.          prname = RESULT
  490.         'GETAREXXGADGET 'reqhandle' 'pdir_gadget' STRING'
  491.          pdir = RESULT
  492.         'GETAREXXGADGET 'reqhandle' 'lreku_gadget' CHECKED'
  493.          lreku = RESULT
  494.         'GETAREXXGADGET 'reqhandle' 'print_gadget' CHECKED'
  495.          print = RESULT
  496.         'GETAREXXGADGET 'reqhandle' 'fps_gadget' CHECKED'
  497.          fps = RESULT
  498.  
  499.         'FREAREXXLIST 'rexxlist
  500.         'FREEAREXXREQUESTER 'reqhandle
  501.  
  502.         if (ergebnis = filehandler) then do
  503.             'GETFILEPATH TITLE "please choose the picture path" PATH "'pdir'"'
  504.             if (RC=0) then pdir = result
  505.         end
  506.         if (ergebnis = pprefshandler) then CALL PrintSettings
  507.         if (ergebnis = ptypehandler) then CALL PicTypeSettings
  508.     end
  509.     if (right(pdir,1) ~= ':') then
  510.         if (right(pdir,1) ~= '/') then pdir = pdir||'/'
  511. RETURN
  512.  
  513. PrintSettings:
  514.     'ALLOCAREXXREQUESTER "Please set the settings for printing ..." 230 80'
  515.      reqhandle2 = RESULT
  516.     'ADDAREXXGADGET 'reqhandle2' EXIT 10  60 70 LABEL "_Ok"'
  517.      okhandler2 = RESULT
  518.     'ADDAREXXGADGET 'reqhandle2' EXIT 150 60 70 LABEL "_Cancel"'
  519.      cancelhandler2 = RESULT
  520.  
  521.     'ALLOCAREXXLIST'
  522.      rexxlist2 = RESULT
  523.     'ADDAREXXLIST 'rexxlist2' "Grayscale"'
  524.     'ADDAREXXLIST 'rexxlist2' "Color"'
  525.     'ADDAREXXGADGET 'reqhandle2' CYCLE 75 10 100 LABEL "Method:"'
  526.      prmethod_gadget = RESULT
  527.     'SETAREXXGADGET 'reqhandle2' 'prmethod_gadget' LIST 'rexxlist2' CURRENT 'prmethod
  528.  
  529.     'ALLOCAREXXLIST'
  530.      rexxlist3 = RESULT
  531.     'ADDAREXXLIST 'rexxlist3' "Actual Size"'
  532.     'ADDAREXXLIST 'rexxlist3' "Scale To Fit"'
  533.     'ADDAREXXGADGET 'reqhandle2' CYCLE 75 30 130 LABEL "Scale:"'
  534.      prscale_gadget = RESULT
  535.     'SETAREXXGADGET 'reqhandle2' 'prscale_gadget' LIST 'rexxlist3' CURRENT 'prscale
  536.  
  537.     'DOAREXXREQUESTER 'reqhandle2
  538.      ergebnis2 = RESULT
  539.  
  540.     if (ergebnis2 = okhandler2)
  541.     then do
  542.         'GETAREXXGADGET 'reqhandle2' 'prmethod_gadget' CURRENT'
  543.          prmethod = RESULT
  544.         'GETAREXXGADGET 'reqhandle2' 'prscale_gadget' CURRENT'
  545.          prscale = RESULT
  546.     end
  547.  
  548.     'FREAREXXLIST 'rexxlist2
  549.     'FREAREXXLIST 'rexxlist3
  550.     'FREEAREXXREQUESTER 'reqhandle2
  551. RETURN
  552.  
  553. PicTypeSettings:
  554.  
  555.     xformats = lformats     /* merken der alten werte */
  556.  
  557.     ergebnis3 = 1
  558.     do until ((ergebnis3 = okhandler3) | (ergebnis3 = cancelhandler3))
  559.         'ALLOCAREXXREQUESTER "Specify the picture types which should be loaded ..." 380 200'
  560.          reqhandle3 = RESULT
  561.         'ADDAREXXGADGET 'reqhandle3' EXIT 10  180 70 LABEL "_Ok"'
  562.          okhandler3 = RESULT
  563.         'ADDAREXXGADGET 'reqhandle3' EXIT 300 180 70 LABEL "_Cancel"'
  564.          cancelhandler3 = RESULT
  565.  
  566.         'ALLOCAREXXLIST'
  567.          rexxlist3src = RESULT
  568.         'ALLOCAREXXLIST'
  569.          rexxlist3dst = RESULT
  570.  
  571.         dc = 0
  572.         sc = 0
  573.  
  574.         do i = 1 to WORDS(formats)
  575.             if WORD(xformats,i) = 1
  576.             then do
  577.                 'ADDAREXXLIST 'rexxlist3dst' "'WORD(formats,i)'"'
  578.                 dc = dc + 1
  579.                 d.dc = i
  580.             end
  581.             else do
  582.                 'ADDAREXXLIST 'rexxlist3src' "'WORD(formats,i)'"'
  583.                 sc = sc + 1
  584.                 s.sc = i
  585.             end
  586.         end
  587.  
  588.         'ADDAREXXGADGET 'reqhandle3' SCROLLIST 10 20  160 150 LABEL "Available:" LABELPOS "ABOVELEFT"'
  589.          srclist3 = RESULT
  590.         'SETAREXXGADGET 'reqhandle3 srclist3' LIST 'rexxlist3src
  591.  
  592.         'ADDAREXXGADGET 'reqhandle3' SCROLLIST 210 20 160 150 LABEL "Types to load:" LABELPOS "ABOVELEFT"'
  593.          dstlist3 = RESULT
  594.         'SETAREXXGADGET 'reqhandle3 dstlist3' LIST 'rexxlist3dst
  595.  
  596.         'ADDAREXXGADGET 'reqhandle3' EXIT 177 80  24 LABEL "--_>"'
  597.          godst3 = RESULT
  598.         'ADDAREXXGADGET 'reqhandle3' EXIT 177 100 24 LABEL "_<--"'
  599.          gosrc3 = RESULT
  600.  
  601.         'DOAREXXREQUESTER 'reqhandle3
  602.          ergebnis3 = RESULT
  603.  
  604.         if (ergebnis3 = godst3)
  605.         then do
  606.             'GETAREXXGADGET 'reqhandle3 srclist3' CURRENT'
  607.             snum = RESULT
  608.             if (snum >= 0)
  609.             then do
  610.                 snum = snum + 1
  611.                 xformats = DELWORD(xformats,s.snum,1)
  612.                 xformats = INSERT('1 ',xformats, 2*s.snum-2)
  613.             end
  614.         end
  615.  
  616.         if (ergebnis3 = gosrc3)
  617.         then do
  618.             'GETAREXXGADGET 'reqhandle3 dstlist3' CURRENT'
  619.             dnum = RESULT
  620.             if (dnum >= 0)
  621.             then do
  622.                 dnum = dnum + 1
  623.                 xformats = DELWORD(xformats,d.dnum,1)
  624.                 xformats = INSERT('0 ',xformats, 2*d.dnum-2)
  625.             end
  626.         end
  627.  
  628.         'FREAREXXLIST 'rexxlist3src
  629.         'FREAREXXLIST 'rexxlist3dst
  630.         'FREEAREXXREQUESTER 'reqhandle3
  631.     end
  632.  
  633.     if (ergebnis3 = okhandler3)
  634.     then lformats = xformats
  635.  
  636. RETURN
  637.  
  638. DOERRORREQUESTER:
  639.     'ALLOCAREXXREQUESTER "Error!" 300 50'
  640.      reqhandle = RESULT
  641.     'ADDAREXXGADGET 'reqhandle' EXIT 115 30 70 LABEL "_Ok"'
  642.      dummy = RESULT
  643.  
  644.     'ADDAREXXGADGET 'reqhandle' TEXT 10 10 280 STRING "Please open a new document first!"'
  645.  
  646.     'DOAREXXREQUESTER 'reqhandle
  647.      dummy = RESULT
  648.  
  649.     'FREEAREXXREQUESTER 'reqhandle
  650.     exit
  651. RETURN
  652.  
  653. ErrorExit:
  654.     'ALLOCAREXXREQUESTER "FATAL ERROR!" 330 70'
  655.      reqhandle = RESULT
  656.     'ADDAREXXGADGET 'reqhandle' EXIT 115 50 70 LABEL "_Ok"'
  657.      dummy = RESULT
  658.  
  659.     'ADDAREXXGADGET 'reqhandle' TEXT 10 10 300 STRING "Picturesize is too big!"'
  660.     'ADDAREXXGADGET 'reqhandle' TEXT 10 30 300 STRING "Please restart with smaller size!"'
  661.  
  662.     'DOAREXXREQUESTER 'reqhandle
  663.      dummy = RESULT
  664.  
  665.     'FREEAREXXREQUESTER 'reqhandle
  666.     call CLEANUP
  667. EXIT
  668.  
  669. SetBusyMessage:
  670.     ARG BReq,BMess
  671.     'SETBUSYREQUESTER 'BReq' MESSAGE "'BMess'"'
  672. RETURN
  673.  
  674. OpenBusyMessage:
  675.     ARG BMess
  676.     BReq = 0
  677.  
  678.     'OPENBUSYREQUESTER MESSAGE "'BMess'" THERMOMETER DISABLED ABORT ENABLED'
  679.      BReq=result
  680. RETURN BReq
  681.  
  682. GETBUSY:
  683.     ARG messname
  684.  
  685.     if (length(messname) > 27)
  686.     then mess = '...'||right(messname,25)
  687.     else mess = messname
  688.  
  689.     Call SetBusyMessage(BusyReq,mess)
  690.     'GETBUSYREQUESTER 'BusyReq
  691.     if (result=1) then do
  692.         if (nppp = 0) then do
  693.             'SELECTOBJECT ALL'
  694.             'DELETEOBJECT'
  695.             'DISPLAY PAGE PREVIOUS'
  696.         end
  697.         CALL CLEANUP
  698.     end
  699. RETURN
  700.  
  701. CLEANUP:
  702.     if (BusyReq>0) then 'CLOSEBUSYREQUESTER 'BusyReq
  703.     cl = Close('flist')
  704.     cl = Close('dlist')
  705.  
  706.     ADDRESS COMMAND 'C:Delete >NIL: T:PicCatalog#?.tmp QUIET'
  707.  
  708.     /* reset the measurementsystem to the saved one!! */
  709.     ''defmeasure''
  710.  
  711.     'REFRESH ON'
  712.     'REFRESHWINDOW'
  713. EXIT
  714.  
  715. ReadPrefs:
  716.     ok = Open('Prefs','PageStream3:Scripts/PicCatalog.prefs','R')
  717.     if (ok = 1)
  718.     then do
  719.         dummy = ReadLn('Prefs')
  720.         if (right(dummy,4) >= '2.11')
  721.         then do
  722.             say 'correct version! reading old prefs...'
  723.  
  724.             pdir = ReadLN('Prefs')
  725.             lreku = ReadLN('Prefs')
  726.             rgapsnsize = ReadLN('Prefs')
  727.             numx = ReadLN('Prefs')
  728.             numy = ReadLN('Prefs')
  729.             fps = ReadLN('Prefs')
  730.             prname = ReadLN('Prefs')
  731.  
  732.             lformats = ReadLN('Prefs')
  733.  
  734.             print = ReadLN('Prefs')
  735.             prmethod = ReadLN('Prefs')
  736.             prscale = ReadLN('Prefs')
  737.             pcpread = 1
  738.         end
  739.         else do
  740.             pcpread = 0
  741.             say 'old prefsfile detected! -> default values'
  742.             pdir = '!OLD PREFSFILE -> USING DEFAULTS!'
  743.         end
  744.         cl = Close('Prefs')
  745.     end
  746.     else do
  747.         pcpread = 0
  748.         say 'no prefsfile! -> default values'
  749.         pdir = '!NO PREFS FOUND -> USING DEFAULTS!'
  750.     end
  751.     if (pcpread = 0)
  752.     then do
  753.         lreku = 0
  754.         rgapsnsize = '2cm 2cm 2cm 2.5cm 5mm 6pt'
  755.         numx = 3
  756.         numy = 4
  757.         fps = 0
  758.         prname = 0
  759.  
  760.         lformats = STRIP(COPIES('1 ',WORDS(formats)))
  761.  
  762.         print = 0
  763.         prmethod = 0
  764.         prscale = 0
  765.     end
  766. RETURN
  767.  
  768. WritePrefs:
  769.     ok = Open('Prefs','PageStream3:Scripts/PicCatalog.prefs','W')
  770.     if (ok = 1) then do
  771.         say 'writing prefs...'
  772.         WriteLN('Prefs','PCP'||pcversion)
  773.         WriteLN('Prefs',pdir)
  774.         WriteLN('Prefs',lreku)
  775.  
  776.         WriteLN('Prefs',rgapsnsize)
  777.  
  778.         WriteLN('Prefs',numx)
  779.         WriteLN('Prefs',numy)
  780.         WriteLN('Prefs',fps)
  781.         WriteLN('Prefs',prname)
  782.  
  783.         WriteLN('Prefs',lformats)
  784.  
  785.         WriteLN('Prefs',print)
  786.         WriteLN('Prefs',prmethod)
  787.         WriteLN('Prefs',prscale)
  788.         cl = Close('Prefs')
  789.         end
  790.     else do
  791.         say 'error writing prefs file "PicCatalog.prefs"'
  792.     end
  793. RETURN
  794.  
  795. DrawPageBorder:
  796.     d1 = leftgap - 5
  797.     d2 = topgap - 5
  798.     d3 = pagesizex-rightgap + 5
  799.     d4 = pagesizey-bottomgap + 5
  800.  
  801.     'DRAWBOX 'd1 d2 d3 d4
  802.     'SETSTROKEWEIGHT 3pt'
  803.  
  804.     d4 = d4 + 2
  805.     'DRAWTEXTOBJ 'd1 d4' INFRONT'
  806.      txtid = RESULT
  807.     'SELECTTEXT AT 'd1 d4' FRONTMOST'
  808.     bottomtxtsize = 12
  809.     bottomtwidth = d3 - d1
  810.  
  811.     'BEGINCOMMANDCAPTURE'
  812.      'SETTRACKTABLE NONE'
  813.      'SETLEADING RELATIVE 100%'
  814.      'SETTYPESIZE "'bottomtxtsize'"'
  815.     'ENDCOMMANDCAPTURE'
  816.  
  817.     'INSERT "PicCatalog '||pcversion||' - ©1996 Michael Merkel"'
  818.     'SETTABRULER "RIGHT" 'bottomtwidth
  819.     'INSERTCONTROL TAB'
  820.     'INSERT "Page 'pagenumber'"'
  821. RETURN
  822.  
  823. RekDir:
  824.     PROCEDURE EXPOSE measure num numx numy anzp leftgap topgap rightgap bottomgap pagesizex pagesizey psf psx psy gap txtsize lreku BusyReq print prname prmethod prscale defmeasure pcversion startx starty lastpic pagenumber nppp fps maxheight formats lformats
  825.  
  826.     ARG dir
  827.  
  828.     ADDRESS COMMAND 'C:list dir="'||dir||'" LFORMAT="%F%N" FILES >T:PicCatalogFilesUS.tmp'
  829.  
  830.     if (GetLength('T:PicCatalogFilesUS.tmp') = 0)
  831.         then ADDRESS COMMAND 'C:Copy T:PicCatalogFilesUS.tmp TO T:PicCatalogFilesS.tmp'
  832.         else do
  833.             ADDRESS COMMAND 'C:Sort FROM T:PicCatalogFilesUS.tmp TO T:PicCatalogFilesS.tmp'
  834.             CALL WorkFileList
  835.         end
  836.     ADDRESS COMMAND 'C:Delete >NIL: T:PicCatalogFilesUS.tmp T:PicCatalogFilesS.tmp QUIET'
  837.     if (lreku = 1) then do
  838.         ADDRESS COMMAND 'C:List dir="'||dir||'" LFORMAT="%F%N" DIRS >T:PicCatalogDirsUS.tmp'
  839.         if (GetLength('T:PicCatalogDirsUS.tmp') = 0)
  840.             then ADDRESS COMMAND 'C:Copy T:PicCatalogDirsUS.tmp TO T:PicCatalogDirsS.tmp'
  841.             else do
  842.                 ADDRESS COMMAND 'C:Sort FROM T:PicCatalogDirsUS.tmp TO T:PicCatalogDirsS.tmp'
  843.                 CALL WorkDirList
  844.             end
  845.     end
  846. RETURN 0
  847.  
  848. WorkFileList:
  849.     PROCEDURE EXPOSE measure num numx numy anzp leftgap topgap rightgap bottomgap pagesizex pagesizey psf psx psy gap txtsize lreku BusyReq print prname prmethod prscale defmeasure pcversion startx starty lastpic pagenumber nppp fps maxheight formats lformats
  850.  
  851.     fnum = 0
  852.     if (Open('flist','t:PicCatalogFilesS.tmp','R') ~= 1) then do
  853.         say 'Fehler beim Öffnen des File-TmpFiles!!!'
  854.         exit
  855.     end
  856.  
  857.     do while (eof('flist') = 0)
  858.         named = readln('flist')
  859.         if (eof('flist') = 0) then do
  860.             name.fnum = named
  861.             fnum = fnum + 1
  862.         end
  863.     end
  864.     cl = Close('flist')
  865.  
  866.     do k = 0 to fnum-1
  867.         CALL AddPicture(name.k)
  868.     end
  869.  
  870. RETURN
  871.  
  872. WorkDirList:
  873.     PROCEDURE EXPOSE measure num numx numy anzp leftgap topgap rightgap bottomgap pagesizex pagesizey psf psx psy gap txtsize lreku BusyReq print prname prmethod prscale defmeasure pcversion startx starty lastpic pagenumber nppp fps maxheight formats lformats
  874.  
  875.     ad = 0
  876.     if(Open('dlist','t:PicCatalogDirsS.tmp','R') ~= 1) then do
  877.         say 'Fehler beim Öffnen des DIR-TmpFiles!!!'
  878.         exit
  879.     end
  880.  
  881.     do while (eof('dlist') = 0)
  882.         name = readln('dlist')
  883.         if (eof('dlist') = 0) then do
  884.             dirname.ad = name
  885.             ad = ad + 1
  886.         end
  887.     end
  888.     cl = Close('dlist')
  889.  
  890.     ADDRESS COMMAND 'C:Delete >NIL: T:PicCatalogDirsUS.tmp T:PicCatalogDirsS.tmp QUIET'
  891.  
  892.     do k = 0 to ad-1
  893.         CALL RekDir(dirname.k)
  894.     end
  895. RETURN
  896.  
  897. GetLength:
  898.     PROCEDURE EXPOSE BusyReq
  899.     ARG filename
  900.  
  901.     ADDRESS COMMAND 'C:List 'filename' LFORMAT="%l" >T:PicCatalogLength.tmp'
  902.     if (Open('flength','T:PicCatalogLength.tmp','R') = 1) then do
  903.         l = ReadLN('flength')
  904.         cl = Close('flength')
  905.         ADDRESS COMMAND 'C:Delete >NIL: T:PicCatalogLength.tmp QUIET'
  906.         if (compare(l,'empty') = 0)
  907.             then return 0
  908.             else return l
  909.     end
  910.     else return 0
  911. RETURN ll
  912.  
  913. DumpText:
  914.     ARG dumptxt,dumpmode
  915.  
  916.     if (Open('dump','T:PicCatalog.dumpfile','A') = 1) then do
  917.         if dumpmode = 0 then wl = WriteCH('dump',dumptxt)
  918.         else                 wl = WriteLN('dump',dumptxt)
  919.         cl = Close('dump')
  920.     end
  921. RETURN
  922.  
  923. PrintPage:
  924.     output.0 = 'GRAYSCALE'
  925.     output.1 = 'COLOR'
  926.  
  927.     if (Open('dump','T:PicCatalog.dumpfile','A') = 1) then do
  928.         WriteLN('dump','printing page')
  929.         cl = Close('dump')
  930.     end
  931.  
  932.     Call SetBusyMessage(BusyReq,'printing page...')
  933.  
  934.     if (prscale = 0) then do
  935.          'PRINTDOCUMENT PAGE "" OUTPUT 'output.prmethod' SCALE "ACTUAL"'
  936.     end
  937.     if (prscale = 1) then do
  938.          'PRINTDOCUMENT PAGE "" OUTPUT 'output.prmethod' SCALE "FULLPAGE"'
  939.     end
  940.  
  941.     'SELECTOBJECT ALL'
  942.     'DELETEOBJECT'
  943. RETURN
  944.  
  945. GetDefaultMeasurementSystem:
  946.     PROCEDURE
  947.  
  948.     'GETMEASUREMENTS COORDINATE stemc RELATIVE rel TEXT tex FROM fro'
  949.      st = 'SETMEASUREMENTS COORDINATE 'stemc.horizontal stemc.vertical' RELATIVE 'rel' TEXT 'tex' FROM 'fro
  950.     'SETMEASUREMENTS COORDINATE POINTS SAMEAS RELATIVE SAMEAS TEXT POINTS FROM PAGE'
  951. RETURN st
  952.